﻿module UnfoldMonad

open System

open System.Collections.Generic
open System.Linq
open System.Text.RegularExpressions
open Microsoft.FSharp.Collections
open Microsoft.Xna.Framework
open Microsoft.Xna.Framework.Audio
open Microsoft.Xna.Framework.Content
open Microsoft.Xna.Framework.GamerServices
open Microsoft.Xna.Framework.Graphics
open Microsoft.Xna.Framework.Input
open Microsoft.Xna.Framework.Media
open EntitiesAndGameState
open Component
open Utils

type Unfold<'a,'s,'r> = ('s * 'r * Time * Time) -> Step<'a,'s,'r>
and Step<'a,'s,'r> = Done of 'a | Next of Unfold<'a,'s,'r>

type GameResult = EntitiesAndGameState.GameState

type UnfoldBuilder<'s,'r>() =
  member this.Delay f = f()
  member this.Return(x:'a) : Unfold<'a,'s,'r> =
    fun s -> Done x
  member this.Bind(p:Unfold<'a,'s,'r>,k:'a->Unfold<'b,'s,'r>):Unfold<'b,'s,'r> =
    fun s ->
      match p s with
      | Done x -> Next(k x)
      | Next p' -> Next(this.Bind(p',k))
  member this.Combine(p:Unfold<Unit,'s,'r>,r:Unfold<'b,'s,'r>):Unfold<'b,'s,'r> =
    fun s ->
      match p s with
      | Done x -> Next(r)
      | Next p' -> Next(this.Combine(p',r))
  member this.For(items:seq<'a>, body:'a -> Unfold<Unit,'s,'r>) : Unfold<Unit,'s,'r> =
    fun s ->
      if items |> Seq.length = 0 then 
        Done()
      else
        let hd,tl = items |> Seq.head, items |> Seq.skip 1
        Next(this.Combine(body hd, this.For(tl, body)))
  member this.While(cond : Unit -> bool, body:Unfold<Unit,'s,'r>) : Unfold<Unit,'s,'r> =
    fun s ->
      if cond() then
        match body s with
        | Done() -> Next(this.While(cond,body))
        | Next body' -> Next(this.Combine(body',this.While(cond, body)))
      else 
        Done()
  member this.Zero() = this.Return()
  member this.ReturnFrom p = p

type RenderState = { mutable Text : (string * Vector2 * Vector2 * Color) option;
                     mutable TopText : (string * Vector2 * Vector2 * Color) option;
                     mutable Texture1 : (string * Vector2 * Vector2 * Color) option;
                     mutable Texture2 : (string * Vector2 * Vector2 * Color) option}

type GameState = IStateProvider<BaseLevelStats>

type Script<'a> = Unfold<'a,GameState,RenderState>

let unfold = UnfoldBuilder<GameState,RenderState>()

let set_render_texture_1 texture p c s : Script<Unit> = 
  fun (_,r, rt, gt) -> Done(r.Texture1 <- Some (texture,p,s,c))

let remove_render_texture_1 : Script<Unit> =
  fun (s,r, rt, gt) -> Done(r.Texture1 <- None)

let set_render_texture_2 texture p c s : Script<Unit> = 
  fun (_,r, rt, gt) -> Done(r.Texture2 <- Some (texture,p,s,c))

let remove_render_texture_2 : Script<Unit> =
  fun (s,r, rt, gt) -> Done(r.Texture2 <- None)

let set_render_text text p c s : Script<Unit> = 
  fun (_,r, rt, gt) -> Done(r.Text <- Some (text,p,s,c))

let set_top_render_text text p c s : Script<Unit> = 
  fun (_,r, rt, gt) -> Done(r.TopText <- Some (text,p,s,c))

let get_render_text : Script<_> = 
  fun (_,r, rt, gt) -> 
    match r.Text with
    | None -> Done ""
    | Some (t,_,_,_) -> Done t

    
let get_onTap : Script<_> =
  (fun (s:GameState,r,rt,gt) -> Done(s.CurrentState.onTap))
  
let set_onTap (value:bool) : Script<_> =
  (fun (s:GameState,r,rt,gt) -> Done(s.CurrentState.onTap <- value))

let remove_render_text : Script<Unit> = 
  fun (s,r, rt, gt) -> Done(r.Text <- None)

let remove_top_render_text : Script<Unit> = 
  fun (s,r, rt, gt) -> Done(r.TopText <- None)

type AnimationState = Entering of float32 | Entered | Exiting of float32 | NoAnimation

let prova2 = 2

let mk_script (game:Game) (sprite_batch:SpriteBatch)
              (script:Script<GameResult>) (game_state:GameState) 
              current_game_time (game_result:ref<GameResult Option>) =

  let animation = ref NoAnimation
  let animation_time = 0.3f
  let current_time = ref { T = 0.0f; DT = 0.0f }
  let level = ref 0
//  do game_result := None
  let screen_size = Vector2((float32 game.GraphicsDevice.Viewport.Width),
                            (float32 game.GraphicsDevice.Viewport.Height))
  let renderer = {Text = None; TopText = None; Texture1 = None; Texture2 = None}
  let script = ref script
  let update (gt:GameTime) = 
    let dt = gt.ElapsedGameTime.TotalSeconds|> float32
    current_time := {T = current_time.Value.T + dt; DT = dt}
    script := match script.Value (game_state,renderer,!current_time,!current_game_time) with
              | Done res ->                 
                game_result := Some res
                (fun _ -> Done res)
              | Next s' -> s'

  let fps = ref 0.0f

  let draw (gt:GameTime) =
      sprite_batch.Begin(SpriteSortMode.Immediate,
              BlendState.AlphaBlend, SamplerState.LinearClamp, 
              DepthStencilState.None, null, null, 
              Matrix.CreateScale(screen_size.X / 100.0f,
                                  screen_size.Y / 100.0f, 1.0f))

      let draw_string_centered (f:SpriteFont) (t:String) (p:Vector2) (c:Color) (s:Vector2) =
        let t_size = f.MeasureString(t)
        let t_center = t_size * 0.5f
        let scale = 100.0f / screen_size.X // min (s.X / t_size.X) 1.0f
        sprite_batch.DrawString(f, t, p, c, 0.0f, t_center, scale * 0.9f, SpriteEffects.None, 0.0f)
    

      match renderer.Texture2 with
      | Some(t,p,s,c) -> 
        let r = Rectangle((p.X - s.X * 0.5f) |> int, (p.Y - s.Y * 0.5f) |> int, 
                          (s.X) |> int, (s.Y) |> int)
        sprite_batch.Draw(game.Content.Load(t), r, c)
      | _ -> ()

      match renderer.Text with
      | Some(t,p,s,c) -> 
        let r = Rectangle((p.X - s.X * 0.5f) |> int, (p.Y - s.Y * 0.5f) |> int, 
                          (s.X) |> int, (s.Y) |> int)
        sprite_batch.Draw(game.Content.Load(@"UIWAG\black_label"), r, Color.Black)
        let rec split (strs:string list) y =
            match strs with
                [] -> ()
                |x::xs -> 
                    draw_string_centered (game.Content.Load("Fonts/OCRAExtended24")) x y c s
                    split xs (y + Vector2(0.0f,4.0f))

//          let str_ref = ref ""
//          (str.Take (Math.Min(t.Length, 30))) |> Seq.iter(fun (elem: char) -> str_ref  := !str_ref + elem.ToString()) 
//          draw_string_centered (game.Content.Load("Fonts/OCRAExtended24")) !str_ref y c s
//          if str.Length > 30 then       
//            str_ref := ""
//            (str.Skip 30) |> Seq.iter(fun (elem: char) -> str_ref  := !str_ref + elem.ToString())
//            split !str_ref (y + Vector2(0.0f,4.0f))
            ()
        split (t.Split([|"#"|], StringSplitOptions.None) |> Array.toList) p
      | _ -> ()

      match renderer.TopText with
      | Some(t,p,s,c) ->         
        let v_c = c.ToVector4()
        let c =Color(Vector4(v_c.X,v_c.Y,v_c.Z,(Math.Sin(gt.TotalGameTime.TotalMilliseconds/100.0) |> float32)))
        draw_string_centered (game.Content.Load("Fonts/OCRAExtended24")) t p c s
      | _ -> ()

      match renderer.Texture1 with
      | Some(t,p,s,c) -> 
        let r = Rectangle((p.X - s.X * 0.5f) |> int, (p.Y - s.Y * 0.5f) |> int, 
                          (s.X) |> int, (s.Y) |> int)
        sprite_batch.Draw(game.Content.Load(t), r, c)
      | _ -> ()


//      let fps' = 1.0f / (gt.ElapsedGameTime.TotalSeconds |> float32)
//      fps := MathHelper.Lerp(!fps, fps', 0.1f)
////
//      draw_string_centered (game.Content.Load("Fonts/OCRAExtended14")) (level.Value.ToString("##")) (Vector2(15.0f, 96.0f)) Color.White
//                          (Vector2(6.0f,8.0f))


      sprite_batch.End()

  { update = update; draw = draw }

let time (c,n,rt,gt) = Done rt

let wait_with_tap max_dt =
  let rec wait t0 =
    unfold{
      let! t = time
      let dt = t.T - t0.T
      let! tap = get_onTap
      do! set_onTap false
      if dt < max_dt && not tap then
        return! wait t0
    }
  unfold {
    let! t0 = time
    return! wait t0
  }

let wait max_dt =
  let rec wait t0 =
    unfold{
      let! t = time
      let dt = t.T - t0.T
      do! set_onTap false
      if dt < max_dt then
        return! wait t0
    }
  unfold {
    let! t0 = time
    return! wait t0
  }

let wait_and_print_step max_dt dt_step msg (color:RGB) text_center text_size =
  let rec aux_wait t0 =
    unfold{
      let! t = time
      let dt = t.T - t0.T
      do! set_render_text (msg+" "+(int (max_dt - dt)).ToString()) text_center color.ToColor text_size
      if dt < max_dt then
        do! wait (min (max_dt - dt) dt_step)
        return! aux_wait t0
    }
  unfold {
    let! t0 = time
    return! aux_wait t0
  }
let wait_and_print max_dt msg (color:RGB) text_center text_size =
  let rec wait t0 =
    unfold{
      let! t = time      
      let dt = t.T - t0.T
      do! set_render_text (msg+" "+(int (max_dt - dt)).ToString()) text_center color.ToColor text_size
      if dt < max_dt then
        return! wait t0
    }
  unfold {
    let! t0 = time
    return! wait t0
  }
let wait_and_print_without_time max_dt msg text_center color text_size =
  let rec wait t0 =
    unfold{
      let! t = time      
      let dt = t.T - t0.T
      do! set_render_text msg text_center color text_size
      if dt < max_dt then
        return! wait t0
      do! remove_render_text
    }
  unfold {
    let! t0 = time
    return! wait t0
  }

let rec forever_ (s : Unfold<Unit,_,_>) : Unfold<Unit,_,_> =
  unfold{
    do! s
    return! forever_ s
  }


let rec while_ (c : Script<bool>) (b:Script<Unit>) : Script<Unit> =
  unfold{
    let! c_v = c
    if c_v then
      do! b
      return! while_ c b
    else
      return ()
  }

let ignore_ (p:Script<'a>) : Script<Unit> =
  unfold{
    let! _ = p
    return ()
  }

let rec parallel_ (p:Script<'a>) (r:Script<'b>) : Script<'a * 'b> =
  fun s ->
    match p s, r s with
    | Done x, Done y -> Done(x,y)
    | Next p', Next r' -> Next(parallel_ p' r')
    | Next p', Done y -> Next(parallel_ p' (unfold.Return(y)))
    | Done x, Next r' -> Next(parallel_ (unfold.Return(x)) r')

let rec parallel_many_ = 
  function
  | [] -> unfold{return ()}
  | (t:Script<'a>) :: (ts:Script<'a> list) -> parallel_ t (parallel_many_ ts) |> ignore_

type Either<' a,' b> = Left of ' a | Right of ' b
let rec parallel_first_ (p:Script<'a>) (r:Script<'b>) : Script<Either<'a, 'b>> =
  fun s ->
    match p s, r s with
    | Done x, _ -> Done(Left x)
    | _, Done y -> Done(Right y)
    | Next p', Next r' -> Next(parallel_first_ p' r')

let rec atomic_ (p:Script<'a>) : Script<'a> =
  fun s ->
    match p s with
    | Done x -> Done x 
    | Next p' -> atomic_ p' s

let not_ (p:Script<bool>) : Script<bool> =
  unfold{
    let! res = p
    return res |> not
  }

let and_ (a:Script<bool>) (b:Script<bool>) : Script<bool> =
  unfold{
    let! a = a
    let! b = b
    return a && b
  }

let or_ (a:Script<bool>) (b:Script<bool>) : Script<bool> =
  unfold{
    let! a = a
    let! b = b
    return a || b
  }

let rec run_ (p:Script<'a>) =
  fun s ->
    match p s with
    | Done x -> x 
    | Next p' -> run_ p' s

let wait_while_ c = while_ c (unfold{ return () })

let show_for t p c s dt =
  unfold{
    do! set_render_text t p c s
    do! wait dt
    do! remove_render_text    
  }

let iter_ f l =
  unfold{
    for x in l do f x
  }

let get_enemies_to_remove : Script<_> =
  (fun (s:GameState,r,rt,gt) -> Done(s.CurrentState.enemies_to_remove))

let get_garbages : Script<_> =
  (fun (s:GameState,r,rt,gt) -> Done(s.CurrentState.enemies))

let get_garbage (e_i) : Script<_> =
  (fun (s:GameState,r,rt,gt) -> Done(s.CurrentState.enemies.[e_i]))
  
let get_garbage_sac : Script<_> =
  (fun (s:GameState,r,rt,gt) -> Done(s.CurrentState.asteroids))

let get_bounding : Script<_> =
  (fun (s:GameState,r,rt,gt) -> Done(s.CurrentState.bounding_sphere))

let update_time_to_next_level : Script<_> =
  (fun (s:GameState,r,rt,gt) -> Done(s.CurrentState.time_to_next_level <- s.CurrentState.time_to_next_level - gt.DT))

let set_time_to_next_level (value:float32) : Script<_> =
  (fun (s:GameState,r,rt,gt) -> Done(s.CurrentState.time_to_next_level <- value))

let inc_level : Script<_> =
  (fun (s:GameState,r,rt,gt) -> Done(s.CurrentState.level <- s.CurrentState.level + 1))

let use_garbage (g_i) (action : Ship -> Script<'a>) : Script<'a> =
  (fun (s:GameState,r,rt,gt) -> Next(s.CurrentState.enemies.[g_i] |> action)) |> atomic_

let use_level (action : int -> Script<'a>) : Script<'a> =
  (fun (s:GameState,r,rt,gt) -> Next(s.CurrentState.level |> action)) |> atomic_

let use_state (action : State -> Script<'a>) : Script<'a> =
  (fun (s:GameState,r,rt,gt) -> Next(s.CurrentState |> action)) |> atomic_

let use_camera_bounding (action : BoundingSphere -> Script<'a>) : Script<'a> =
  (fun (s:GameState,r,rt,gt) -> Next(s.CurrentState.bounding_sphere |> action)) |> atomic_

let set_camera_bounding_sphere (center:Vector3) (radius:float32) : Script<Unit> =
  fun (s,r,rt,gt) -> 
    Done (  s.CurrentState.bounding_sphere.Center <- center
            s.CurrentState.bounding_sphere.Radius <- radius)

let set_enemy_to_remove e_i (value:bool) : Script<Unit> =
  fun (s,r,rt,gt) -> 
    Done (s.CurrentState.enemies_to_remove.[e_i].remove_it <- value)

let disable_manhole : Script<Unit> =
  fun (s,r,rt,gt) -> 
    Done (s.CurrentState.is_man_hole_enable <- false)

let add_enemie (ship : EntitiesAndGameState.ShipToAdd) : Script<_> =
  (fun (s:GameState,r,rt,gt) -> 
    Done(  
      let rec find_empty_space i =
        if i < s.CurrentState.enemies_to_add.Length then
          if s.CurrentState.enemies_to_add.[i].IsEnable  then
            find_empty_space (i + 1)
          else          
            s.CurrentState.enemies_to_add.[i] <-
              new ShipToAdd(
                ship.Start,
                ship.Dest,
                ship.IsTouchEnable,
                ship.velocity,
                ship.Garbagetype,
                ship.IsEnable,
                ship.ManualVelocity)
      find_empty_space 0))

let zoom_in max_dt start_center start_radius dest_center dest_radius =
  
  let rec wait t0 =
    unfold{
      let! t = time      
      let dt = t.T - t0.T            
      if dt < max_dt then

        let center = Vector3.Lerp(start_center,dest_center, dt / max_dt)
        let radius = MathHelper.Lerp(start_radius,dest_radius, dt / max_dt)

        do! set_camera_bounding_sphere center radius
        return! wait t0
    }
  unfold {
    let! t0 = time
    return! wait t0
  }

let zoom_in_to_enemie e_i max_dt =
  
  let rec wait t0 (state:State) =
    unfold{
      let! t = time      
      let dt = t.T - t0.T            
      if dt < max_dt then

        let center = Vector3.Lerp(state.bounding_sphere.Center,state.enemies.[e_i].geometry.Position, dt / max_dt)
        let radius = MathHelper.Lerp(state.bounding_sphere.Radius, zoom_enemie_rage, dt / max_dt)

        do! set_camera_bounding_sphere center radius
        return! wait t0 state
    }
  unfold {
    let! t0 = time
    let! state = use_state (fun s -> unfold { return s} )
    return! wait t0 state
  }


let zoom_out time =
  unfold{
    let! bs = get_bounding
    do! zoom_in 1.0f bs.Center bs.Radius Vector3.Zero 5.0f
  }
  
let rec set_render_texts (msgLst:string list) (interval:float32) text_center color text_size =
  unfold{    
    match msgLst with
    |[] -> ()
    |msg::lst -> 
      do! set_render_text msg text_center color text_size
      do! wait interval    
      do! set_render_texts lst interval text_center color text_size        
  }

let rec set_render_texts_with_tap (msgLst:string list) text_center color text_size =
  unfold{    
    match msgLst with
    |[] -> ()
    |msg::lst -> 
      do! set_render_text msg text_center color text_size
      do! set_top_render_text "<<TAP TO CONTINUE>>" (Vector2(50.0f, 82.0f)) Color.White (Vector2(50.0f, 15.0f))
      do! wait_with_tap 10.0f
      do! set_render_texts_with_tap lst text_center color text_size        
  }
